---
title: "Teste Prático - EstatMG"
author: "Arthur Damasceno"
date: today
lang: pt-BR
format:
html:
theme:
light: cosmo
dark: darkly
toc: true
code-fold: show
code-tools: true
code-summary: "Mostrar/ocultar código"
code-copy: true
code-line-numbers: true
self-contained: true
df-print: paged
smooth-scroll: true
title-block-banner: true
page-layout: full
editor: visual
execute:
warning: false
message: false
echo: false
---
```{r setup, include=FALSE}
library(readxl)
library(tidyverse)
library(corrplot)
library(hms)
library(ggcorrplot)
library(lubridate)
library(reactable)
library(htmltools)
library(leaflet)
library(scales)
```
## Resumo
Com base na análise de acidentes rodoviários de 2020, os principais pontos de risco foram identificados, revelando padrões geográficos, temporais e de condições específicas. A análise mostra que, embora Betim tenha o maior volume de acidentes, Patos de Minas apresenta a maior taxa de mortalidade. As rodovias BR-381 e BR-040 são as mais perigosas, com quilômetros específicos na BR-040 apontados como de alta criticidade. O tipo de acidente mais comum é a "saída de leito carroçável". Fatores como o clima e o tipo de pista também são determinantes: a neblina e as pistas simples estão associadas a uma maior severidade dos acidentes. Temporalmente, os finais de semana concentram a maior frequência de ocorrências. O horário mais letal é a madrugada, apesar de a maioria dos acidentes ocorrer nos horários de pico. Observou-se também uma queda atípica em abril, possivelmente pela pandemia de COVID-19, e um pico em dezembro, relacionado às viagens de fim de ano.
### 1.1 Análise Preliminar dos Dados
Os dados já estão bem organizados e é possível inferir facilmente o significado das colunas. Um possível ponto de confusão é o formato da data (`data_inversa`), que segue o padrão internacional (ano/mês/dia).
```{r}
# Carregamento dos dados
Acidentes_2020 <- read_excel("C:/Users/DamaLaptoper/Pictures/EstatMG/Acidentes_2020.xlsx", na = "NA")
Acidentes_2020$horario <- as_hms(Acidentes_2020$horario)
```
**Tabela 1.1: Resumo detalhado das variáveis do dataset de acidentes.**
| Informação | Variável |
|:------------------|:----------------------------------------------------|
| **Onde e Quando** | id \| data \| dia \| horário \| uf \| **br** (6% NA) \| **km** (6% NA) \| município |
| **Como Aconteceu** | tipo_acidente \| fase_dia \| condicao_metereologica \| tipo_pista |
| **Impacto do Acidente** | pessoas \| mortos \| feridos \| ilesos \| veiculos |
| **Localização Precisa** | latitude \| longitude |
### 1.1.1 Estatísticas Descritivas
A análise das estatísticas descritivas das variáveis numéricas não revelou, à primeira vista, dados suspeitos ou a existência de outliers evidentes, considerando valores como o número máximo e mínimo de feridos, o desvio padrão e a variância. Alguns achados interessantes envolvem os veículos, uma vez que a mediana é 1,0, enquanto a média é 1,55. Isso significa que mais de 50% dos acidentes registrados envolvem apenas um único veículo.
O número máximo de pessoas envolvidas é de 14; no entanto, a média é de 2,23 pessoas. Considerando as mortes e os feridos graves, a mediana, o primeiro e o terceiro quartil são zero. Portanto, pelo menos 75% de todos os acidentes neste dataset não tiveram vítimas fatais.
Além disso, existem pouquíssimos valores ausentes (NA), concentrados nas colunas `br` e `km`, que se referem, respectivamente, à rodovia e ao quilômetro onde o acidente ocorreu. Essas ausências correspondem a cerca de 6,12% do total de observações. Tais observações não aparentam ter um padrão em comum, seja em localização, número de vítimas ou tipo de acidente, o que sugere que podem ser falhas no momento do registro dos dados ou acidentes em locais não formalmente catalogados.
```{r}
casos_br_faltante <- Acidentes_2020 |>
filter(is.na(br)) |>
select(where(~ !is.numeric(.x)))
casos_br_faltante <- casos_br_faltante |>
dplyr::rename(
Data = data_inversa,
Dia = dia_semana,
Hora = horario,
Acidente = tipo_acidente,
Fase = fase_dia,
Clima = condicao_metereologica,
Pista = tipo_pista,
Mun = municipio
)
reactable(
casos_br_faltante, # Usando a tibble com nomes curtos
striped = TRUE,
highlight = TRUE,
bordered = TRUE,
theme = reactableTheme(
headerStyle = list(
backgroundColor = "#F57F17",
fontWeight = "bold",
color = "white"
)
)
)
```
A matriz de correlação (Método de Spearman) indicou, em sua maioria, relações con- sideradas óbvias entre as variáveis. Como no correlogramas abaixo
```{r}
dados_numericos <- Acidentes_2020 |>
select(where(is.numeric), -latitude, -longitude)
matriz_cor <- cor(dados_numericos)
colnames(matriz_cor) <- c(
"ID", "BR", "KM", "Pessoas", "Mortos",
"F.Leves", "F.Graves", "Ilesos",
"Feridos", "Veículos"
)
rownames(matriz_cor) <- c(
"ID", "BR", "KM", "Pessoas", "Mortos",
"F.Leves", "F.Graves", "Ilesos",
"Feridos", "Veículos"
)
ggcorrplot(matriz_cor,
method = "square",
type = "lower",
colors = c("#6D9EC1", "white", "#E46726"),
lab = TRUE,
lab_size = 4,
show.diag = FALSE,
ggtheme = theme_classic
) + # Tema clássico
labs(title = "Correlações - Método de Spearman") +
theme(
plot.title = element_text(hjust = 0.5, size = 16, margin = margin(b = 13)),
) +
guides(
fill = guide_legend(
title = NULL,
ncol = 1,
keywidth = unit(20, "pt"),
keyheight = unit(20, "pt"),
label = TRUE,
reverse = TRUE
)
) +
theme(
legend.key.spacing.y = unit(3, "pt")
)
```
As correlações mais fortes estão relacionadas ao número de pessoas envolvidas e suas consequências imediatas. Logicamente, se há mais pessoas, haverá mais veículos, feridos e ilesos. O restante das correlações observadas parece ser bem razoável.
As medidas de associação, por outro lado, trazem resultados mais curiosos. O município onde aconteceu o acidente parece ter relação com a maioria das variáveis, o que pode significar que municípios com estruturas viárias piores ou mais antigas influenciam o tipo de ocorrência. Além disso, o tipo de pista parece estar bem associado ao tipo de acidente.
```{r}
#| include: false
dados_categoricos <- Acidentes_2020 |>
select(where(~ !is.numeric(.x)), -horario, -data_inversa, -uf)
cramersV_fun <- function(x, y) {
tab <- table(x, y)
if (nrow(tab) < 2 || ncol(tab) < 2) {
return(NA) # não tem como calcular
} else {
return(lsr::cramersV(tab))
}
}
# Criar matriz vazia
n <- ncol(dados_categoricos)
mat <- matrix(NA, n, n)
colnames(mat) <- rownames(mat) <- colnames(dados_categoricos)
# Preencher a matriz
for (i in 1:n) {
for (j in 1:n) {
mat[i, j] <- cramersV_fun(dados_categoricos[[i]], dados_categoricos[[j]])
}
}
colnames(mat) <- c(
"Dia da Semana", "Município", "Tipo Acidente",
"Fase do Dia", "Cond. Metereológica", "Tipo Pista"
)
rownames(mat) <- c(
"Dia da Semana", "Município", "Tipo Acidente",
"Fase do Dia", "Cond. Metereológica", "Tipo Pista"
)
```
```{r}
ggcorrplot(mat,
method = "square",
type = "lower",
colors = c("#6D9EC1", "white", "#E46726"),
lab = TRUE,
lab_size = 4,
show.diag = FALSE,
ggtheme = theme_classic
) +
labs(title = "Associação entre Variáveis Categóricas (V de Cramer)") +
theme(
plot.title = element_text(hjust = 0.5, size = 16, margin = margin(b = 13)),
) +
guides(
fill = guide_legend(
title = NULL,
ncol = 1,
keywidth = unit(20, "pt"),
keyheight = unit(20, "pt"),
label = TRUE,
reverse = TRUE
)
) +
theme(
legend.key.spacing.y = unit(3, "pt")
)
```
## 1.2 Planejamento da Análise
Diante desse cenário e para realizar tanto as análises solicitadas quanto outras explorações pertinentes, elaboramos os seguintes **eixos para guiar o trabalho**.
> **Objetivo do Cliente**
>
> "Meu objetivo é avaliar as **principais causas de acidentes** nas rodovias de Minas Gerais, bem como um **mapeamento dos tipos de acidentes e das rodovias**. Também gostaria de entender os acidentes de acordo com variáveis relativas a tempo: **dia da semana e mês**."
### Eixos de Análise Propostos
1.
## **Análise das Causas de Acidentes:**
```
(a) Distribuição por condição meteorológica.
```
-
(b) Distribuição por tipo de pista.
2.
## **Análise de Variáveis Temporais:**
```
(a) Evolução mensal do número de acidentes.
```
-
(b) Distribuição de acidentes por dia da semana.
-
(c) Distribuição por faixa de horário.
3.
## **Análise de Variáveis Geográficas:**
```
(a) Distribuição geográfica de mortos e feridos.
```
-
(b) Ranking das 10 principais rodovias (BRs) com maior número de ocorrências.
4.
## **Métricas e Proporções Chave:**
```
(a) Taxa de mortalidade
```
-
(b) Taxa de feridos graves
-
(c) Taxa de ilesos
## 1.2 Análise das Causas de Acidentes
### Distribuição por Condição Meteorológica
```{r}
# Distribuição por condição meteorológica
dist_severidade_condicao <- Acidentes_2020 |>
group_by(condicao_metereologica) |>
summarise(
Frequencia_Acidentes = n(),
Total_Mortos = sum(mortos, na.rm = TRUE),
Total_Pessoas = sum(pessoas, na.rm = TRUE),
.groups = 'drop'
) |>
mutate(
Taxa_Mortalidade_Acidente = round(Total_Mortos / Frequencia_Acidentes, 3),
Taxa_Mortalidade_Geral = round(Total_Mortos / Total_Pessoas * 100, 2)
) |>
rename(`Condição Meteorológica` = condicao_metereologica,
`Frequência` = Frequencia_Acidentes,
`Mortos/Acidente` = Taxa_Mortalidade_Acidente,
`Mortalidade (%)` = Taxa_Mortalidade_Geral) |>
arrange(desc(`Frequência`))
reactable(
dist_severidade_condicao,
columns = list(
`Condição Meteorológica` = colDef(name = "Condição", minWidth = 150),
`Frequência` = colDef(
name = "Frequência",
cell = function(value) {
width <- paste0(value / max(dist_severidade_condicao$`Frequência`) * 100, "%")
bar_color <- "#F57F17"
div(
class = "bar-cell",
style = list(background = paste0("linear-gradient(90deg, ", bar_color, " ", width, ", transparent ", width, ")")),
value
)
},
minWidth = 120
),
Total_Mortos = colDef(name = "Mortos", align = "center", defaultSortOrder = "desc"),
`Mortos/Acidente` = colDef(
name = "Mortos/Ac.",
align = "center",
format = colFormat(digits = 3, suffix = "x"),
defaultSortOrder = "desc"
),
Total_Pessoas = colDef(show = FALSE),
`Mortalidade (%)` = colDef(name = "Mortalidade (%)", format = colFormat(suffix = "%", digits = 2), minWidth = 110)
),
striped = TRUE,
highlight = TRUE,
bordered = TRUE,
defaultSorted = "Frequência",
defaultSortOrder = "desc",
theme = reactableTheme(
headerStyle = list(backgroundColor = "#F57F17", color = "white", fontWeight = "bold")
)
)
```
Quanto à influência do clima, observa-se que a maioria dos acidentes ocorre sob céu limpo. No entanto, a taxa de mortalidade é substancialmente maior em condições de neblina, o que reforça a necessidade de condução cuidadosa neste contexto.
```{r}
df_plot <- dist_severidade_condicao |>
mutate(`Condição Meteorológica` = factor(`Condição Meteorológica`,
levels = unique(`Condição Meteorológica`)))
taxa_max <- max(df_plot$`Mortos/Acidente`, na.rm = TRUE)
contagem_max <- max(df_plot$`Frequência`, na.rm = TRUE)
TAXA_FATOR <- contagem_max / taxa_max
grafico_severidade <- ggplot(df_plot, aes(x = `Condição Meteorológica`)) +
geom_col(aes(y = `Frequência`, fill = `Condição Meteorológica`),
show.legend = FALSE,
alpha = 0.8) +
geom_line(aes(y = `Mortos/Acidente` * TAXA_FATOR),
color = "#DC143C",
linewidth = 1.2,
group = 1) +
geom_point(aes(y = `Mortos/Acidente` * TAXA_FATOR),
color = "#8B0000",
size = 3) +
scale_y_continuous(
name = "Frequência de Acidentes",
sec.axis = sec_axis(~./TAXA_FATOR,
name = "Mortos por Acidente (Taxa)",
labels = number_format(accuracy = 0.001))
) +
labs(
title = "Frequência de Acidentes vs. Severidade por Condição Meteorológica",
subtitle = "A linha vermelha indica o risco médio de fatalidade por acidente (Eixo Secundário).",
x = "Condição Meteorológica"
) +
theme_minimal() +
theme(
axis.text.x = element_text(angle = 45, hjust = 1),
axis.title.y.right = element_text(color = "#DC143C", margin = margin(l = 10))
)
grafico_severidade
```
### Distribuição por Tipo de Pista
```{r}
# Distribuição por tipo de pista
dist_tipo_pista <- Acidentes_2020 |>
group_by(tipo_pista) |>
summarise(
Frequencia = n(),
Total_Mortos = sum(mortos, na.rm = TRUE),
Total_Pessoas = sum(pessoas, na.rm = TRUE),
.groups = 'drop'
) |>
mutate(
Taxa_Mortalidade_Acidente = round(Total_Mortos / Frequencia, 3),
Taxa_Mortalidade_Geral = round(Total_Mortos / Total_Pessoas * 100, 2)
) |>
rename(
`Tipo de Pista` = tipo_pista,
`Frequência` = Frequencia,
`Mortos/Acidente` = Taxa_Mortalidade_Acidente,
`Mortalidade (%)` = Taxa_Mortalidade_Geral
) |>
arrange(desc(`Frequência`))
reactable(
dist_tipo_pista,
columns = list(
`Tipo de Pista` = colDef(name = "Tipo de Pista", minWidth = 200),
`Frequência` = colDef(
name = "Frequência",
cell = function(value) {
width <- paste0(value / max(dist_tipo_pista$`Frequência`) * 100, "%")
bar_color <- "#F57F17"
div(
class = "bar-cell",
style = list(background = paste0("linear-gradient(90deg, ", bar_color, " ", width, ", transparent ", width, ")")),
value
)
},
minWidth = 120
),
Total_Mortos = colDef(
name = "Mortos",
align = "center",
defaultSortOrder = "desc"
),
`Mortos/Acidente` = colDef(
name = "Mortos/Ac.",
align = "center",
format = colFormat(digits = 3, suffix = "x"),
defaultSortOrder = "desc"
),
Total_Pessoas = colDef(show = FALSE),
`Mortalidade (%)` = colDef(
name = "Mortalidade (%)",
format = colFormat(suffix = "%", digits = 2),
minWidth = 110
)
),
striped = TRUE,
highlight = TRUE,
bordered = TRUE,
defaultSorted = "Frequência",
defaultSortOrder = "desc",
theme = reactableTheme(
headerStyle = list(backgroundColor = "#F57F17", color = "white", fontWeight = "bold")
)
)
```
Embora o tipo de pista não apresente uma correlação intensa com a mortalidade geral, nota-se uma maior concentração de mortes em acidentes ocorridos em pistas simples.
### Distribuição por Tipo de Acidente
```{r}
# Distribuição por tipo de acidente
dist_tipo_acidente <- Acidentes_2020 |>
count(tipo_acidente, name = "Frequência") |>
mutate(Percentual = round(Frequência / sum(Frequência) * 100, 2)) |>
arrange(desc(Frequência)) |>
rename(`Tipo de Acidente` = tipo_acidente)
reactable(
dist_tipo_acidente,
columns = list(
`Tipo de Acidente` = colDef(name = "Tipo de Acidente", minWidth = 250),
Frequência = colDef(
name = "Frequência",
cell = function(value) {
width <- paste0(value / max(dist_tipo_acidente$Frequência) * 100, "%")
bar_color <- "#F57F17"
div(
class = "bar-cell",
style = list(background = paste0("linear-gradient(90deg, ", bar_color, " ", width, ", transparent ", width, ")")),
value
)
}
),
Percentual = colDef(
name = "Percentual (%)",
format = colFormat(suffix = "%", digits = 2)
)
),
striped = TRUE,
highlight = TRUE,
bordered = TRUE,
defaultSorted = "Frequência",
defaultSortOrder = "desc",
theme = reactableTheme(
headerStyle = list(backgroundColor = "#F57F17", fontWeight = "bold")
)
)
```
O tipo de acidente mais frequente é a "saída de leito carroçável", correspondendo a 25% do total das ocorrências. Este evento ocorre quando um veículo sai da pista e se desloca para uma área adjacente (barranco, ribanceira, etc.).
```{r}
# Gráfico 4
# Preparar dados para o heatmap
dados_heatmap <- Acidentes_2020 |>
count(tipo_acidente, tipo_pista) |>
group_by(tipo_pista) |>
mutate(percentual = n / sum(n) * 100) |> # percentual já está calculado
ungroup()
# Criar heatmap
ggplot(dados_heatmap, aes(x = tipo_pista, y = tipo_acidente, fill = percentual)) + # Alterado: fill = percentual
geom_tile(color = "white", size = 0.5) +
geom_text(
aes(label = paste0(round(percentual, 1), "%")), # Alterado: label para percentual com %
color = "white",
fontface = "bold",
size = 3.5
) +
scale_fill_gradient(
low = "#ffd7ba",
high = "#F57F17",
name = "Percentual (%)" # Alterado o nome da legenda
) +
labs(
title = "Gráfico 4: Distribuição de Acidentes por Tipo e Pista (Percentual por Pista)", # Sugestão: Ajustar o título
x = "Tipo de Pista",
y = "Tipo de Acidente"
) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold", size = 14),
axis.text.x = element_text(angle = 45, hjust = 1, size = 10),
axis.text.y = element_text(size = 10),
axis.title = element_text(face = "bold", size = 11),
legend.position = "right", panel.grid = element_blank()
)
```
De acordo com o plot, pistas Duplas e Múltiplas mostram maior propensão a acidentes relacionados ao fluxo (colisão traseira), enquanto a pista Simples evidencia o alto risco de acidentes severos como a colisão frontal.
```{r}
# --- Plot Sugerido 1: Letalidade por Tipo de Acidente ---
letalidade_por_tipo <- Acidentes_2020 |>
group_by(tipo_acidente) |>
summarise(
total_pessoas = sum(pessoas, na.rm = TRUE),
total_mortos = sum(mortos, na.rm = TRUE),
total_acidentes = n(),
.groups = "drop"
) |>
mutate(
taxa_mortalidade = (total_mortos / total_pessoas) * 100,
# Reordenar os tipos de acidente pela taxa de mortalidade para melhor visualização
tipo_acidente_fator = fct_reorder(tipo_acidente, taxa_mortalidade)
) |>
arrange(desc(taxa_mortalidade)) |>
head(10)
plot_letalidade_tipo <- ggplot(letalidade_por_tipo, aes(x = taxa_mortalidade, y = tipo_acidente_fator, fill = taxa_mortalidade)) +
geom_col(show.legend = FALSE) +
geom_text(aes(label = paste0(round(taxa_mortalidade, 1), "%")), hjust = -0.2, size = 3.5, color = "black") +
scale_fill_gradient(low = "#FFC107", high = "#D32F2F") +
labs(
title = "Top 10 Tipos de Acidente Mais Letais",
subtitle = "Taxa de mortalidade percentual por tipo de ocorrência",
x = "Taxa de Mortalidade (%)",
y = "Tipo de Acidente"
) +
theme_minimal() +
scale_x_continuous(limits = c(0, max(letalidade_por_tipo$taxa_mortalidade) * 1.1))
plot_letalidade_tipo
```
## 1.3 Análise Temporal
### Acidentes por Mês
```{r}
analise_mensal_percentual <- Acidentes_2020 |>
mutate(mes_ano = floor_date(data_inversa, "month")) |>
count(mes_ano, name = "acidentes_no_mes") |>
mutate(
percentual_mes = acidentes_no_mes / sum(acidentes_no_mes),
percentual_acumulado = cumsum(percentual_mes),
Mês = month(mes_ano, label = TRUE, abbr = FALSE)
) |>
select(
Mês,
`Nº de Acidentes` = acidentes_no_mes,
`% do Total no Mês` = percentual_mes,
`% Acumulado no Ano` = percentual_acumulado
)
reactable(
analise_mensal_percentual,
columns = list(
Mês = colDef(name = "Mês", minWidth = 120),
`Nº de Acidentes` = colDef(
name = "Nº de Acidentes",
cell = function(value) {
width <- paste0(value / max(analise_mensal_percentual$`Nº de Acidentes`) * 100, "%")
bar_color <- "#F57F17"
div(
class = "bar-cell",
style = list(background = paste0("linear-gradient(90deg, ", bar_color, " ", width, ", transparent ", width, ")")),
format(value, big.mark = ".")
)
}
),
`% do Total no Mês` = colDef(
name = "% do Total no Mês",
format = colFormat(percent = TRUE, digits = 1)
),
`% Acumulado no Ano` = colDef(
name = "% Acumulado no Ano",
format = colFormat(percent = TRUE, digits = 1)
)
),
striped = TRUE,
highlight = TRUE,
bordered = TRUE,
theme = reactableTheme(
headerStyle = list(backgroundColor = "#F57F17", fontWeight = "bold", color = "white")
)
)
```
Dezembro destaca-se como o mês com o maior número de acidentes, uma tendência que pode ser atribuída ao aumento do tráfego durante as viagens de fim de ano. Em oposição, abril regista o menor volume de ocorrências, um resultado provavelmente relacionado com o fenómeno do isolamento social.
```{r}
acidentes_mensais <- Acidentes_2020 |>
mutate(mes_ano = floor_date(data_inversa, "month")) |>
group_by(mes_ano) |>
summarise(total_acidentes = n()) |>
ungroup()
ggplot(acidentes_mensais, aes(x = mes_ano, y = total_acidentes)) +
geom_line(color = "#3399FF", linewidth = 1) +
geom_point(color = "#0066CC", size = 2) +
geom_vline(xintercept = as.Date("2020-04-01"), linetype = "dashed", color = "darkred") +
# Rótulos
labs(
title = "Total de Acidentes por Mês (2020)",
subtitle = "Possível impacto da pandemia a partir de Abril",
x = "Mês",
y = "Total de Acidentes"
) +
# Tema limpo
theme_minimal() +
scale_x_date(date_breaks = "1 month", date_labels = "%b-%y") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
```
A análise mensal do total de acidentes revela uma queda acentuada em abril, que pode ser inferida como um resultado das restrições impostas pela pandemia de COVID-19. Em contrapartida, observa-se um pico de ocorrências em dezembro, possivelmente associado às viagens de fim de ano.
```{r}
ordem_dias <- c("domingo", "segunda", "terça", "quarta", "quinta", "sexta", "sábado")
acidentes_dia_semana_final <- Acidentes_2020 |>
mutate(dia_semana_fator = factor(dia_semana, levels = ordem_dias)) |>
group_by(dia_semana_fator) |>
summarise(
total_acidentes = n(),
media_acidentes = n() / n_distinct(data_inversa)
) |>
ungroup()
ggplot(acidentes_dia_semana_final, aes(x = dia_semana_fator, y = media_acidentes, fill = media_acidentes)) +
geom_col(show.legend = FALSE) +
# Adiciona os valores nas barras
geom_text(aes(label = round(media_acidentes, 0)), vjust = -0.5) +
# Rótulos
labs(
title = "Média Diária de Acidentes por Dia da Semana (2020)",
x = "Dia da Semana",
y = "Média de Acidentes por Dia"
) +
theme_minimal()
```
Quanto à distribuição semanal, sexta-feira, sábado e domingo são os dias com maior volume de acidentes, o que pode ser atribuído ao aumento do fluxo de veículos devido a lazer, viagens e outros compromissos de fim de semana.
### Acidentes por Dia da Semana
```{r}
# Análise por dia da semana
ordem_dias <- c("domingo", "segunda", "terça", "quarta", "quinta", "sexta", "sábado")
acidentes_dia_semana_final <- Acidentes_2020 |>
mutate(dia_semana_fator = factor(dia_semana, levels = ordem_dias)) |>
group_by(dia_semana_fator) |>
summarise(
total_acidentes = n(),
media_acidentes = round(n() / n_distinct(data_inversa), 1)
) |>
ungroup() |>
rename(
`Dia da Semana` = dia_semana_fator,
`Total de Acidentes` = total_acidentes,
`Média Diária` = media_acidentes
)
reactable(
acidentes_dia_semana_final,
columns = list(
`Dia da Semana` = colDef(name = "Dia da Semana", minWidth = 150),
`Total de Acidentes` = colDef(
name = "Total de Acidentes",
cell = function(value) {
width <- paste0(value / max(acidentes_dia_semana_final$`Total de Acidentes`) * 100, "%")
bar_color <- "#F57F17"
div(
class = "bar-cell",
style = list(background = paste0("linear-gradient(90deg, ", bar_color, " ", width, ", transparent ", width, ")")),
value
)
}
),
`Média Diária` = colDef(
name = "Média Diária",
format = colFormat(digits = 1)
)
),
striped = TRUE,
highlight = TRUE,
bordered = TRUE,
theme = reactableTheme(
headerStyle = list(backgroundColor = "#F57F17", fontWeight = "bold", color = "white")
)
)
```
```{r}
heatmap_data <- Acidentes_2020 |>
mutate(
dia_semana_fator = factor(dia_semana, levels = c("segunda", "terça", "quarta", "quinta", "sexta", "sábado", "domingo")),
fase_dia_fator = factor(fase_dia, levels = c("Pleno dia", "Amanhecer", "Anoitecer", "Plena Noite"))
) |>
count(dia_semana_fator, fase_dia_fator, name = "total_acidentes") |>
group_by(fase_dia_fator) |>
mutate(proporcao = total_acidentes / sum(total_acidentes)) |>
ungroup()
plot_heatmap_dia_fase <- ggplot(heatmap_data, aes(x = dia_semana_fator, y = fase_dia_fator, fill = proporcao)) +
geom_tile(color = "white") +
# Modificação 1: Usar a coluna 'proporcao' e formatá-la como porcentagem no rótulo
geom_text(aes(label = percent(proporcao, accuracy = 0.1)), color = "black", size = 3.5) +
# Modificação 2: Atualizar a escala de cores e a legenda para refletir a proporção
scale_fill_gradient(low = "#FFFDE7", high = "#F57F17", name = "Proporção", labels = percent_format()) +
# Modificação 3: Ajustar os títulos para indicar que são proporções
labs(
title = "Distribuição Proporcional de Acidentes por Dia e Fase",
subtitle = "Mapa de calor mostrando a proporção de acidentes em cada período do dia",
x = "Dia da Semana",
y = "Fase do Dia"
) +
theme_minimal() +
theme(
axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "right",
panel.grid = element_blank()
)
plot_heatmap_dia_fase
```
As manhãs de sábado apresentam a maior proporção de ocorrências (19,5%), despontando como o período mais crítico. Em seguida, as noites de sexta-feira a domingo formam um bloco de alto risco, com proporções que variam de 16,9% a 18,5%. Este padrão sugere que o início e o fim dos períodos de lazer do fim de semana são momentos que demandam maior atenção e possíveis ações preventivas.
### Acidentes por Hora do Dia
```{r}
# Análise por hora do dia
acidentes_por_hora <- Acidentes_2020 |>
mutate(hora_dia = hour(horario)) |>
group_by(hora_dia) |>
summarise(
total_acidentes = n(),
.groups = "drop"
) |>
arrange(hora_dia)
reactable(
acidentes_por_hora,
columns = list(
# Coluna 1: Hora do Dia
hora_dia = colDef(name = "Hora do Dia (0-23)",
align = "center",
minWidth = 120),
total_acidentes = colDef(
name = "Total de Acidentes",
align = "left",
minWidth = 200,
cell = function(value) {
width <- paste0(value / max(acidentes_por_hora$total_acidentes) * 100, "%")
bar_color <- "#F57F17"
div(
style = list(background = paste0("linear-gradient(90deg, ", bar_color, " ", width, ", transparent ", width, ")"),
padding = "4px 8px",
margin = "-4px 0"),
value
)
}
)
),
striped = TRUE,
highlight = TRUE,
bordered = TRUE,
defaultSorted = "hora_dia",
defaultSortOrder = "asc",
theme = reactableTheme(
headerStyle = list(backgroundColor = "#F57F17", color = "white", fontWeight = "bold")
)
)
```
```{r}
faixas_ordem <- c("madrugada (00h-05h)", "manhã (06h-11h)", "tarde (12h-17h)", "noite (18h-23h)")
df_contagem <- Acidentes_2020 |>
mutate(
hora_dia = hour(horario),
faixa_cor = case_when(
hora_dia >= 6 & hora_dia < 12 ~ "manhã (06h-11h)",
hora_dia >= 12 & hora_dia < 18 ~ "tarde (12h-17h)",
hora_dia >= 18 & hora_dia < 24 ~ "noite (18h-23h)",
TRUE ~ "madrugada (00h-05h)"
) |> factor(levels = faixas_ordem)
) |>
group_by(hora_dia, faixa_cor) |>
summarise(total_acidentes = n(), .groups = "drop")
df_taxas <- Acidentes_2020 |>
mutate(hora_dia = hour(horario)) |>
group_by(hora_dia) |>
summarise(
total_pessoas = sum(pessoas, na.rm = TRUE),
total_mortos = sum(mortos, na.rm = TRUE),
Taxa_Mortalidade = (total_mortos / total_pessoas) * 100,
.groups = "drop"
)
# Escala de cores para as faixas
faixa_cores <- c(
"madrugada (00h-05h)" = "#607D8B",
"manhã (06h-11h)" = "#FFC107",
"tarde (12h-17h)" = "#FF5722",
"noite (18h-23h)" = "#3F51B5"
)
TAXA_TRANSFORM_FATOR <- max(df_contagem$total_acidentes) / max(df_taxas$Taxa_Mortalidade)
ggplot(df_contagem, aes(x = hora_dia, y = total_acidentes)) +
geom_col(aes(fill = faixa_cor), alpha = 0.8) +
geom_line(
data = df_taxas,
aes(y = Taxa_Mortalidade * TAXA_TRANSFORM_FATOR), # Aplica a transformação
color = "#D32F2F", linewidth = 1
) +
geom_point(
data = df_taxas,
aes(y = Taxa_Mortalidade * TAXA_TRANSFORM_FATOR),
color = "#D32F2F", size = 2
) +
scale_y_continuous(
name = "Total de Acidentes", # Nome do Eixo Y Esquerdo
sec.axis = sec_axis(~ . / TAXA_TRANSFORM_FATOR, # Desfaz a transformação no segundo eixo
name = "Taxa de Mortalidade (%)",
labels = scales::percent_format(scale = 1)
)
) +
scale_fill_manual(values = faixa_cores, name = "Faixa do Dia") +
scale_x_continuous(breaks = seq(0, 23, by = 2)) +
labs(
title = "Contagem de Acidentes e Taxa de Mortalidade por Hora",
subtitle = "Barras coloridas por Faixa do Dia | Linha Vermelha = Taxa de Mortalidade",
x = "Hora do Dia (0 a 23)"
) +
theme_minimal() +
theme(
legend.position = "bottom",
axis.title.y.right = element_text(color = "#D32F2F"), # Cor do título do eixo secundário
axis.line.y.right = element_line(color = "#D32F2F")
)
```
```{r}
ggplot(acidentes_por_hora, aes(x = hora_dia, y = total_acidentes)) +
geom_col(fill = "#F57F17", alpha = 0.8) +
geom_line(color = "red", linewidth = 1) +
geom_point(color = "darkred", size = 2) +
labs(
title = "Total de Acidentes por Hora do Dia (2020)",
subtitle = "Frequência de acidentes hora a hora. Observe os picos.",
x = "Hora do Dia (0 a 23)",
y = "Total de Acidentes"
) +
scale_x_continuous(breaks = seq(0, 23, by = 2)) +
theme_minimal()
```
A análise por horário acompanha a mesma lógica dos dias úteis, com picos de acidentes no início da manhã (aproximadamente às 6h) e no final da tarde, coincidindo com os horários de deslocamento para o trabalho. No entanto, a mortalidade segue um padrão distinto: a madrugada concentra o maior número de mortes, com um aumento progressivo que se inicia no começo da noite.
## 1.4 Análise Geográfica
### Top 10 Municípios com Mais Mortos e Feridos
```{r}
# Distribuição geográfica de mortos e feridos por município
mortos_por_municipio <- Acidentes_2020 |>
group_by(municipio) |>
summarise(
total_mortos = sum(mortos, na.rm = TRUE),
total_feridos = sum(feridos, na.rm = TRUE),
acidentes = n()
) |>
arrange(desc(total_mortos)) |>
slice_head(n = 10) |>
rename(
Município = municipio,
`Total de Mortos` = total_mortos,
`Total de Feridos` = total_feridos,
`Total de Acidentes` = acidentes
)
reactable(
mortos_por_municipio,
columns = list(
Município = colDef(name = "Município", minWidth = 200),
`Total de Mortos` = colDef(
name = "Total de Mortos",
),
`Total de Feridos` = colDef(
name = "Total de Feridos",
cell = function(value) {
width <- paste0(value / max(mortos_por_municipio$`Total de Feridos`) * 100, "%")
bar_color <- "#F57F17"
div(
class = "bar-cell",
style = list(background = paste0("linear-gradient(90deg, ", bar_color, " ", width, ", transparent ", width, ")")),
value
)
}
),
`Total de Acidentes` = colDef(name = "Total de Acidentes")
),
striped = TRUE,
highlight = TRUE,
bordered = TRUE,
theme = reactableTheme(
headerStyle = list(backgroundColor = "#F57F17", fontWeight = "bold", color = "white")
)
)
```
Na análise das variáveis geográficas, percebe-se que, embora o município de Betim registre o maior número absoluto de acidentes, Patos de Minas apresenta o maior número de mortes.
### Top 10 Rodovias (BRs) com Mais Ocorrências
```{r}
# Ranking das principais rodovias
top10_brs <- Acidentes_2020 |>
filter(!is.na(br) & br != "") |>
count(br, name = "Total de Ocorrências") |>
arrange(desc(`Total de Ocorrências`)) |>
slice_head(n = 10) |>
rename(Rodovia = br)
reactable(
top10_brs,
columns = list(
Rodovia = colDef(
name = "Rodovia (BR)",
cell = function(value) {
div(paste0("BR-", value)
)
}
),
`Total de Ocorrências` = colDef(
name = "Total de Ocorrências",
cell = function(value) {
width <- paste0(value / max(top10_brs$`Total de Ocorrências`) * 100, "%")
bar_color <- "#F57F17"
div(
class = "bar-cell",
style = list(background = paste0("linear-gradient(90deg, ", bar_color, " ", width, ", transparent ", width, ")")),
value
)
}
)
),
striped = TRUE,
highlight = TRUE,
bordered = TRUE,
theme = reactableTheme(
headerStyle = list(backgroundColor = "#F57F17", fontWeight = "bold", color = "white")
)
)
```
### Top 10 Pontos Críticos (BR + KM)
```{r}
# Ranking dos pontos mais críticos
top10_kms <- Acidentes_2020 |>
filter(!is.na(br) & br != "" & !is.na(km)) |>
count(br, km, name = "Ocorrências") |>
arrange(desc(Ocorrências)) |>
slice_head(n = 10) |>
mutate(
`Ponto Crítico` = paste0("BR-", br, " KM ", km)
) |>
select(`Ponto Crítico`, Ocorrências)
reactable(
top10_kms,
columns = list(
`Ponto Crítico` = colDef(
name = "Ponto Crítico",
minWidth = 200
),
Ocorrências = colDef(
name = "Ocorrências",
cell = function(value) {
width <- paste0(value / max(top10_kms$Ocorrências) * 100, "%")
bar_color <- "#F57F17"
div(
class = "bar-cell",
style = list(background = paste0("linear-gradient(90deg, ", bar_color, " ", width, ", transparent ", width, ")")),
value
)
}
)
),
striped = TRUE,
highlight = TRUE,
bordered = TRUE,
theme = reactableTheme(
headerStyle = list(backgroundColor = "#F57F17", fontWeight = "bold", color = "white")
)
)
```
As rodovias BR-381 e BR-040 concentram o maior número de ocorrências, um dado consistente com a reputação de ambas. Uma análise mais detalhada por quilómetro revela que a BR-040 domina o ranking de pontos críticos, especialmente nos KMs 510 e 511. Esta concentração sugere a provável existência de uma falha grave de planeamento ou segurança nesse trecho específico.
## 1.5 Métricas e Proporções Chave
```{r}
# Cálculo das taxas principais
totais <- Acidentes_2020 |>
summarise(
Total_Pessoas = sum(pessoas),
Total_Mortos = sum(mortos),
Total_Feridos_Graves = sum(feridos_graves),
Total_Ilesos = sum(ilesos)
)
metricas_chave <- data.frame(
Métrica = c("Taxa de Mortalidade", "Taxa de Feridos Graves", "Taxa de Ilesos"),
Valor = c(
round((totais$Total_Mortos / totais$Total_Pessoas) * 100, 2),
round((totais$Total_Feridos_Graves / totais$Total_Pessoas) * 100, 2),
round((totais$Total_Ilesos / totais$Total_Pessoas) * 100, 2)
),
`Total Absoluto` = c(
totais$Total_Mortos,
totais$Total_Feridos_Graves,
totais$Total_Ilesos
)
)
```
## Taxas de Severidade e Ilesos (2020)
| Métrica | Valor (%) | Total Absoluto |
|:-----------------------|:---------:|---------------:|
| Taxa de Mortalidade | 3.58% | 521 |
| Taxa de Feridos Graves | 12.66% | 1.845 |
| Taxa de Ilesos | 39.70% | 5.785 |
As taxas gerais do conjunto de dados revelam uma percentagem de acidentes fatais que, embora baixa, é significativa. A análise gráfica indica que, na maioria das ocorrências com vítimas fatais, regista-se apenas uma morte por acidente.
```{r}
# 2. Gráfico de barras para o número de mortos por acidente
plot_bar_mortos <- Acidentes_2020 |>
filter(mortos > 0) |> # Foco nos acidentes fatais
count(mortos, name = "total_acidentes") |>
ggplot(aes(x = as.factor(mortos), y = total_acidentes)) +
geom_col(fill = "#F57F17") +
geom_text(aes(label = total_acidentes), vjust = -0.5) +
labs(
title = "Distribuição do Número de Mortos em Acidentes Fatais",
subtitle = "Quando há mortes, geralmente é uma única vítima por acidente",
x = "Número de Mortos no Acidente",
y = "Frequência (Nº de Acidentes)"
) +
theme_minimal()
plot_bar_mortos
```
Para a análise da distribuição geográfica dos acidentes, foram gerados dois mapas interativos.
O primeiro mapa representa cada acidente como um círculo, onde o raio é proporcional à gravidade do evento (número de mortos). Esta visualização permite a rápida identificação dos acidentes mais letais e sua localização exata.
```{r}
# 1. Preparar os dados (garantir que não haja NAs em coords)
Acidentes_para_leaflet <- Acidentes_2020 |>
filter(!is.na(latitude) & !is.na(longitude)) |>
# Limpar o texto do popup (ex: concatenar UF, BR e Tipo de Acidente)
mutate(
popup_info = paste0(
"<b>Tipo:</b> ", tipo_acidente, "<br/>",
"<b>Local:</b> BR-", br, " / Km ", km, "<br/>",
"<b>UF:</b> ", uf, "<br/>",
"<b>Mortos:</b> ", mortos
)
)
# 2. Criar o Mapa Interativo
mapa_leaflet_pontos <- Acidentes_para_leaflet |>
leaflet() |>
# Adiciona uma camada base (aqui usamos OpenStreetMap)
addTiles() |>
# Define o centro inicial do mapa (aprox. centro de MG)
# O 'zoom' pode ser ajustado
setView(lng = -44.5, lat = -18.5, zoom = 6) |>
# Adiciona a Camada de Pontos (Marcadores Circulares)
addCircles(
lng = ~longitude,
lat = ~latitude,
# Mapear o raio ou a cor para a severidade (ex: mortos)
radius = ~ log1p(mortos + 1) * 900, # Aumenta o raio para mortes
color = "#F57F17", # Cor vermelha
fillOpacity = 0.5,
stroke = FALSE, # Remove a borda
popup = ~popup_info # Adiciona o popup interativo
) |>
# Adiciona um controle de camadas (para mudar o mapa base)
addProviderTiles(providers$CartoDB.DarkMatter, group = "Escuro") |>
addLayersControl(
baseGroups = c("OpenStreetMap", "Escuro"),
options = layersControlOptions(collapsed = TRUE)
)
mapa_leaflet_pontos
```
O segundo mapa utiliza uma técnica de clusterização (agrupamento), que agrupa acidentes geograficamente próximos em um único ponto. Essa abordagem é ideal para identificar "hotspots", ou seja, as áreas com maior concentração e frequência de acidentes, limpando a visualização em escalas mais amplas.
```{r}
# Mapeia os dados brutos como marcadores com clusterização
mapa_leaflet_cluster <- Acidentes_para_leaflet |>
leaflet() |>
addTiles() |>
setView(lng = -44.5, lat = -18.5, zoom = 6) |>
addMarkers(
lng = ~longitude,
lat = ~latitude,
clusterOptions = markerClusterOptions(),
popup = ~popup_info
)
mapa_leaflet_cluster
```
## Conclusão
Este trabalho analisou os acidentes rodoviários em Minas Gerais durante o ano de 2020. A análise revelou que as rodovias BR-381 e BR-040 são os principais focos de ocorrências, com pontos específicos na BR-040 apresentando uma concentração de acidentes.
Temporalmente, os finais de semana e os horários de pico (manhã e final de tarde) registram o maior volume de colisões. Contudo, é na madrugada que o risco de morte se torna mais elevado. Fatores como pista simples e condições de neblina também foram associados a uma maior severidade dos acidentes, enquanto a "saída de leito carroçável" se destacou como o tipo de ocorrência mais frequente.
Os resultados apontam para a necessidade de intervenções estratégicas. A fiscalização deve ser intensificada nos trechos mais críticos identificados. Campanhas de segurança devem alertar para os perigos específicos da condução na madrugada e em condições climáticas adversas. A longo prazo, o investimento na melhoria da infraestrutura.
Embora limitado ao ano atípico de 2020, os dados se mostraram muito relevantes e completos, com diversas têndencias ao longo do EDA, como texto prático gostei muito de realizar o trabalho, agradeço a EstatMG pela oportunidade e quem sabe fazer parte do time!
Obrigado pela Atenção.
```{css}
.bar-cell {
padding: 4px 8px;
border-radius: 4px;
}
```
